home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 2005 June (DVD) / DPPRO0605DVD.iso / Install / program files / Borland / BDS / 3.0 / Demos / Delphi.Net / VCL / ConvertIt / EuroConv.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2004-10-22  |  8.9 KB  |  260 lines
  1. unit EuroConv;
  2.  
  3. { ***************************************************************************
  4.   Monetary conversion units
  5.  
  6.   The constants, names and monetary logic in this unit follow the various EU
  7.   standards layed out in documents 397R1103, 398R2866 and 300R1478.
  8.  
  9.   WARNING: In order for the rounding rules to exactly match the EU dictates
  10.            this unit will adjust your application's rounding mode to rmUp.
  11.            This will affect how rounding happens globally and may cause
  12.            unforeseen side effects in your application.
  13.  
  14.   At the time of the writing of this document those documents where at
  15.     http://europa.eu.int/eur-lex/en/lif/dat/1997/en_397R1103.html
  16.     http://europa.eu.int/eur-lex/en/lif/dat/1998/en_398R2866.html
  17.     http://europa.eu.int/eur-lex/en/lif/dat/2000/en_300R1478.html
  18.  
  19.   If not found there you can search for them on http://europa.eu.int/eur-lex
  20.  
  21.   The conversion rates for US dollar, British pound and Japanese yen are
  22.   accurate as of 12/12/2000 at 18:35 EST and were as reported by
  23.   CNNfn (http://cnnfn.cnn.com/markets/currency)
  24.  
  25.   Great monetary exchange rate sites
  26.     http://pacific.commerce.ubc.ca/xr/rates.html
  27.     http://www.imf.org/external/np/tre/sdr/drates/8101.htm
  28.     http://www.belgraver.demon.nl/currconv2/
  29.  
  30.   ***************************************************************************
  31.   References:
  32.   [1]  Article 1 in http://europa.eu.int/eur-lex/en/lif/dat/1998/en_398R2866.html
  33.   [2]  Article 1 in http://europa.eu.int/eur-lex/en/lif/dat/2000/en_300R1478.html
  34.   [3]  Article 4.4 in http://europa.eu.int/eur-lex/en/lif/dat/1997/en_397R1103.html
  35.  
  36. }
  37.  
  38. interface
  39.  
  40. uses
  41.   ConvUtils, Math;
  42.  
  43. var
  44.   // *************************************************************************
  45.   // Euro Conversion Units
  46.   // basic unit of measurement is euro
  47.   cbEuro: TConvFamily;
  48.  
  49.   euEUR: TConvType; { EU euro }
  50.   euBEF: TConvType; { Belgian francs }
  51.   euDEM: TConvType; { German marks }
  52.   euGRD: TConvType; { Greek drachmas }
  53.   euESP: TConvType; { Spanish pesetas }
  54.   euFFR: TConvType; { French francs }
  55.   euIEP: TConvType; { Irish pounds }
  56.   euITL: TConvType; { Italian lire }
  57.   euLUF: TConvType; { Luxembourg francs }
  58.   euNLG: TConvType; { Dutch guilders }
  59.   euATS: TConvType; { Austrian schillings }
  60.   euPTE: TConvType; { Portuguese escudos }
  61.   euFIM: TConvType; { Finnish marks }
  62.  
  63.   euUSD: TConvType; { US dollars }
  64.   euGBP: TConvType; { British pounds }
  65.   euJPY: TConvType; { Japanese yens }
  66.  
  67. const
  68.   // Fixed conversion Euro rates [1]
  69.   EURToEUR = 1.00000;
  70.   BEFToEUR = 40.3399;
  71.   DEMToEUR = 1.95583;
  72.   GRDToEUR = 340.750; // [2] effective 1/1/2001
  73.   ESPToEUR = 166.386;
  74.   FFRToEUR = 6.55957;
  75.   IEPToEUR = 0.787564;
  76.   ITLToEUR = 1936.27;
  77.   LUFToEUR = 40.3399;
  78.   NLGToEUR = 2.20371;
  79.   ATSToEUR = 13.7603;
  80.   PTEToEUR = 200.482;
  81.   FIMToEUR = 5.94573;
  82.  
  83.   // Subunit rounding for Euro conversion and expressed as powers of ten [3]
  84.   EURSubUnit = -2;
  85.   BEFSubUnit =  0;
  86.   DEMSubUnit = -2;
  87.   GRDSubUnit =  0; // [2] effective 1/1/2001
  88.   ESPSubUnit =  0;
  89.   FFRSubUnit = -2;
  90.   IEPSubUnit = -2;
  91.   ITLSubUnit =  0;
  92.   LUFSubUnit = -2;
  93.   NLGSubUnit = -2;
  94.   ATSSubUnit = -2;
  95.   PTESubUnit = -2;
  96.   FIMSubUnit =  0;
  97.  
  98. var
  99.   // Accurate as of 12/12/2000 at 16:42 PST but almost certainly isn't anymore
  100.   // Remember if you are changing these values in realtime you might, depending
  101.   //  on your application's structure, have to deal with threading issues.
  102.   USDToEUR: Double = 1.1369;
  103.   GBPToEUR: Double = 1.6462;
  104.   JPYToEUR: Double = 0.0102;
  105.  
  106.   // Subunit rounding for Euro conversion and expressed as powers of ten
  107.   USDSubUnit: Integer = -2;
  108.   GBPSubUnit: Integer = -2;
  109.   JPYSubUnit: Integer = -2;
  110.  
  111.  
  112. // Registration methods
  113. function RegisterEuroConversionType(const AFamily: TConvFamily;
  114.   const ADescription: string; const AFactor: Double;
  115.   const ARound: TRoundToRange): TConvType; overload;
  116.  
  117. function RegisterEuroConversionType(const AFamily: TConvFamily;
  118.   const ADescription: string; const AToCommonProc,
  119.   AFromCommonProc: TConversionProc): TConvType; overload;
  120.  
  121. // Types used during the conversion of Euro to and from other currencies
  122. type
  123.   TConvTypeEuroFactor = class(TConvTypeFactor)
  124.   private
  125.     FRound: TRoundToRange;
  126.   public
  127.     constructor Create(const AConvFamily: TConvFamily;
  128.       const ADescription: string; const AFactor: Double;
  129.       const ARound: TRoundToRange);
  130.     function ToCommon(const AValue: Double): Double; override;
  131.     function FromCommon(const AValue: Double): Double; override;
  132.   end;
  133.  
  134. // various strings used in this unit
  135.  
  136. resourcestring
  137.   SEuroDescription = 'Euro';
  138.   SEURDescription = 'EUEuro';
  139.   SBEFDescription = 'BelgianFrancs';
  140.   SDEMDescription = 'GermanMarks';
  141.   SGRDDescription = 'GreekDrachmas';
  142.   SESPDescription = 'SpanishPesetas';
  143.   SFFRDescription = 'FrenchFrancs';
  144.   SIEPDescription = 'IrishPounds';
  145.   SITLDescription = 'ItalianLire';
  146.   SLUFDescription = 'LuxembourgFrancs';
  147.   SNLGDescription = 'DutchGuilders';
  148.   SATSDescription = 'AustrianSchillings';
  149.   SPTEDescription = 'PortugueseEscudos';
  150.   SFIMDescription = 'FinnishMarks';
  151.   SUSDDescription = 'USDollars';
  152.   SGBPDescription = 'BritishPounds';
  153.   SJPYDescription = 'JapaneseYens';
  154.  
  155. implementation
  156.  
  157. { TConvTypeEuroFactor }
  158.  
  159. constructor TConvTypeEuroFactor.Create(const AConvFamily: TConvFamily;
  160.   const ADescription: string; const AFactor: Double;
  161.   const ARound: TRoundToRange);
  162. begin
  163.   inherited Create(AConvFamily, ADescription, AFactor);
  164.   FRound := ARound;
  165. end;
  166.  
  167. function TConvTypeEuroFactor.FromCommon(const AValue: Double): Double;
  168. begin
  169.   Result := SimpleRoundTo(AValue * Factor, FRound);
  170. end;
  171.  
  172. function TConvTypeEuroFactor.ToCommon(const AValue: Double): Double;
  173. begin
  174.   Result := AValue / Factor;
  175. end;
  176.  
  177. function RegisterEuroConversionType(const AFamily: TConvFamily;
  178.   const ADescription: string; const AFactor: Double;
  179.   const ARound: TRoundToRange): TConvType;
  180. var
  181.   LInfo: TConvTypeInfo;
  182. begin
  183.   LInfo := TConvTypeEuroFactor.Create(AFamily, ADescription, AFactor, ARound);
  184.   if not RegisterConversionType(LInfo, Result) then
  185.   begin
  186.     LInfo.Free;
  187.     RaiseConversionRegError(AFamily, ADescription);
  188.   end;
  189. end;
  190.  
  191. function RegisterEuroConversionType(const AFamily: TConvFamily;
  192.   const ADescription: string; const AToCommonProc,
  193.   AFromCommonProc: TConversionProc): TConvType;
  194. begin
  195.   Result := RegisterConversionType(AFamily, ADescription,
  196.                                    AToCommonProc, AFromCommonProc);
  197. end;
  198.  
  199. function ConvertUSDToEUR(const AValue: Double): Double;
  200. begin
  201.   Result := AValue * USDToEUR;
  202. end;
  203.  
  204. function ConvertEURToUSD(const AValue: Double): Double;
  205. begin
  206.   Result := SimpleRoundTo(AValue / USDToEUR, USDSubUnit);
  207. end;
  208.  
  209. function ConvertGBPToEUR(const AValue: Double): Double;
  210. begin
  211.   Result := AValue * GBPToEUR;
  212. end;
  213.  
  214. function ConvertEURToGBP(const AValue: Double): Double;
  215. begin
  216.   Result := SimpleRoundTo(AValue / GBPToEUR, GBPSubUnit);
  217. end;
  218.  
  219. function ConvertJPYToEUR(const AValue: Double): Double;
  220. begin
  221.   Result := AValue * JPYToEUR;
  222. end;
  223.  
  224. function ConvertEURToJPY(const AValue: Double): Double;
  225. begin
  226.   Result := SimpleRoundTo(AValue / JPYToEUR, JPYSubUnit);
  227. end;
  228.  
  229. initialization
  230.  
  231.   // Euro's family type
  232.   cbEuro := RegisterConversionFamily(SEuroDescription);
  233.  
  234.   // Euro's various conversion types
  235.   euEUR := RegisterEuroConversionType(cbEuro, SEURDescription, EURToEUR, EURSubUnit);
  236.   euBEF := RegisterEuroConversionType(cbEuro, SBEFDescription, BEFToEUR, BEFSubUnit);
  237.   euDEM := RegisterEuroConversionType(cbEuro, SDEMDescription, DEMToEUR, DEMSubUnit);
  238.   euGRD := RegisterEuroConversionType(cbEuro, SGRDDescription, GRDToEUR, GRDSubUnit);
  239.   euESP := RegisterEuroConversionType(cbEuro, SESPDescription, ESPToEUR, ESPSubUnit);
  240.   euFFR := RegisterEuroConversionType(cbEuro, SFFRDescription, FFRToEUR, FFRSubUnit);
  241.   euIEP := RegisterEuroConversionType(cbEuro, SIEPDescription, IEPToEUR, IEPSubUnit);
  242.   euITL := RegisterEuroConversionType(cbEuro, SITLDescription, ITLToEUR, ITLSubUnit);
  243.   euLUF := RegisterEuroConversionType(cbEuro, SLUFDescription, LUFToEUR, LUFSubUnit);
  244.   euNLG := RegisterEuroConversionType(cbEuro, SNLGDescription, NLGToEUR, NLGSubUnit);
  245.   euATS := RegisterEuroConversionType(cbEuro, SATSDescription, ATSToEUR, ATSSubUnit);
  246.   euPTE := RegisterEuroConversionType(cbEuro, SPTEDescription, PTEToEUR, PTESubUnit);
  247.   euFIM := RegisterEuroConversionType(cbEuro, SFIMDescription, FIMToEUR, FIMSubUnit);
  248.   euUSD := RegisterEuroConversionType(cbEuro, SUSDDescription,
  249.                                       ConvertUSDToEUR, ConvertEURToUSD);
  250.   euGBP := RegisterEuroConversionType(cbEuro, SGBPDescription,
  251.                                       ConvertGBPToEUR, ConvertEURToGBP);
  252.   euJPY := RegisterEuroConversionType(cbEuro, SJPYDescription,
  253.                                       ConvertJPYToEUR, ConvertEURToJPY);
  254.  
  255. finalization
  256.  
  257.   // Unregister all the conversion types we are responsible for
  258.   UnregisterConversionFamily(cbEuro);
  259. end.
  260.